home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / DirectMusic / DLSEffects / dlsfx.frm (.txt) next >
Encoding:
Visual Basic Form  |  2001-10-08  |  15.2 KB  |  441 lines
  1. VERSION 5.00
  2. Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
  3. Begin VB.Form frmMain 
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "DLS Sound Effects"
  6.    ClientHeight    =   4920
  7.    ClientLeft      =   45
  8.    ClientTop       =   330
  9.    ClientWidth     =   5670
  10.    Icon            =   "DLSFX.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   4920
  15.    ScaleWidth      =   5670
  16.    StartUpPosition =   3  'Windows Default
  17.    Begin VB.Frame Frame1 
  18.       Caption         =   "Heartbeat"
  19.       Height          =   3255
  20.       Left            =   120
  21.       TabIndex        =   17
  22.       Top             =   1560
  23.       Width           =   2895
  24.       Begin VB.CommandButton cmdB7 
  25.          Caption         =   "&On"
  26.          BeginProperty Font 
  27.             Name            =   "Arial"
  28.             Size            =   8.25
  29.             Charset         =   0
  30.             Weight          =   400
  31.             Underline       =   0   'False
  32.             Italic          =   0   'False
  33.             Strikethrough   =   0   'False
  34.          EndProperty
  35.          Height          =   495
  36.          Left            =   480
  37.          TabIndex        =   8
  38.          Top             =   360
  39.          Width           =   735
  40.       End
  41.       Begin VB.CommandButton cmdOff 
  42.          Caption         =   "O&ff"
  43.          Enabled         =   0   'False
  44.          BeginProperty Font 
  45.             Name            =   "Arial"
  46.             Size            =   8.25
  47.             Charset         =   0
  48.             Weight          =   400
  49.             Underline       =   0   'False
  50.             Italic          =   0   'False
  51.             Strikethrough   =   0   'False
  52.          EndProperty
  53.          Height          =   495
  54.          Left            =   1800
  55.          TabIndex        =   9
  56.          Top             =   360
  57.          Width           =   735
  58.       End
  59.       Begin MSComctlLib.Slider sliderB7 
  60.          Height          =   375
  61.          Left            =   360
  62.          TabIndex        =   11
  63.          Top             =   1440
  64.          Width           =   2295
  65.          _ExtentX        =   4048
  66.          _ExtentY        =   661
  67.          _Version        =   393216
  68.          LargeChange     =   3
  69.          Min             =   1
  70.          Max             =   13
  71.          SelStart        =   1
  72.          Value           =   1
  73.       End
  74.       Begin MSComctlLib.Slider sliderPitch 
  75.          Height          =   375
  76.          Left            =   360
  77.          TabIndex        =   13
  78.          Top             =   2400
  79.          Width           =   2295
  80.          _ExtentX        =   4048
  81.          _ExtentY        =   661
  82.          _Version        =   393216
  83.          LargeChange     =   1365
  84.          SmallChange     =   128
  85.          Max             =   16383
  86.          SelStart        =   8065
  87.          TickFrequency   =   1365
  88.          Value           =   8065
  89.       End
  90.       Begin VB.Label Label2 
  91.          Caption         =   "&Note (B7-B8)"
  92.          Height          =   255
  93.          Left            =   480
  94.          TabIndex        =   10
  95.          Top             =   1080
  96.          Width           =   1695
  97.       End
  98.       Begin VB.Label lblPitch 
  99.          Caption         =   "&Pitch Bend"
  100.          Height          =   255
  101.          Left            =   480
  102.          TabIndex        =   12
  103.          Top             =   2040
  104.          Width           =   1815
  105.       End
  106.    End
  107.    Begin VB.CommandButton cmdExit 
  108.       Cancel          =   -1  'True
  109.       Caption         =   "E&xit"
  110.       Height          =   495
  111.       Left            =   3720
  112.       TabIndex        =   16
  113.       Top             =   3120
  114.       Width           =   1335
  115.    End
  116.    Begin VB.CommandButton cmdC10 
  117.       BackColor       =   &H00FFFFFF&
  118.       Caption         =   "C&10"
  119.       BeginProperty Font 
  120.          Name            =   "Arial"
  121.          Size            =   8.25
  122.          Charset         =   0
  123.          Weight          =   400
  124.          Underline       =   0   'False
  125.          Italic          =   0   'False
  126.          Strikethrough   =   0   'False
  127.       EndProperty
  128.       Height          =   495
  129.       Left            =   4688
  130.       TabIndex        =   6
  131.       Top             =   720
  132.       Width           =   615
  133.    End
  134.    Begin VB.CommandButton cmdC9 
  135.       Caption         =   "C&9"
  136.       BeginProperty Font 
  137.          Name            =   "Arial"
  138.          Size            =   8.25
  139.          Charset         =   0
  140.          Weight          =   400
  141.          Underline       =   0   'False
  142.          Italic          =   0   'False
  143.          Strikethrough   =   0   'False
  144.       EndProperty
  145.       Height          =   495
  146.       Left            =   3968
  147.       TabIndex        =   5
  148.       Top             =   720
  149.       Width           =   615
  150.    End
  151.    Begin VB.CommandButton cmdC5 
  152.       Caption         =   "C&5"
  153.       BeginProperty Font 
  154.          Name            =   "Arial"
  155.          Size            =   8.25
  156.          Charset         =   0
  157.          Weight          =   400
  158.          Underline       =   0   'False
  159.          Italic          =   0   'False
  160.          Strikethrough   =   0   'False
  161.       EndProperty
  162.       Height          =   495
  163.       Left            =   1808
  164.       TabIndex        =   2
  165.       Top             =   720
  166.       Width           =   615
  167.    End
  168.    Begin VB.CommandButton cmdC4 
  169.       Caption         =   "C&4"
  170.       BeginProperty Font 
  171.          Name            =   "Arial"
  172.          Size            =   8.25
  173.          Charset         =   0
  174.          Weight          =   400
  175.          Underline       =   0   'False
  176.          Italic          =   0   'False
  177.          Strikethrough   =   0   'False
  178.       EndProperty
  179.       Height          =   495
  180.       Left            =   1088
  181.       TabIndex        =   1
  182.       Top             =   720
  183.       Width           =   615
  184.    End
  185.    Begin VB.CommandButton cmdC6 
  186.       Caption         =   "C&6"
  187.       BeginProperty Font 
  188.          Name            =   "Arial"
  189.          Size            =   8.25
  190.          Charset         =   0
  191.          Weight          =   400
  192.          Underline       =   0   'False
  193.          Italic          =   0   'False
  194.          Strikethrough   =   0   'False
  195.       EndProperty
  196.       Height          =   495
  197.       Left            =   2528
  198.       TabIndex        =   3
  199.       Top             =   720
  200.       Width           =   615
  201.    End
  202.    Begin VB.CommandButton cmdC3 
  203.       Caption         =   "C&3"
  204.       BeginProperty Font 
  205.          Name            =   "Arial"
  206.          Size            =   8.25
  207.          Charset         =   0
  208.          Weight          =   400
  209.          Underline       =   0   'False
  210.          Italic          =   0   'False
  211.          Strikethrough   =   0   'False
  212.       EndProperty
  213.       Height          =   495
  214.       Left            =   368
  215.       TabIndex        =   0
  216.       Top             =   720
  217.       Width           =   615
  218.    End
  219.    Begin VB.CommandButton cmdC7 
  220.       Caption         =   "C&7"
  221.       BeginProperty Font 
  222.          Name            =   "Arial"
  223.          Size            =   8.25
  224.          Charset         =   0
  225.          Weight          =   400
  226.          Underline       =   0   'False
  227.          Italic          =   0   'False
  228.          Strikethrough   =   0   'False
  229.       EndProperty
  230.       Height          =   495
  231.       Left            =   3248
  232.       TabIndex        =   4
  233.       Top             =   720
  234.       Width           =   615
  235.    End
  236.    Begin MSComctlLib.Slider sliderVelocity 
  237.       Height          =   195
  238.       Left            =   3360
  239.       TabIndex        =   15
  240.       Top             =   1920
  241.       Width           =   2295
  242.       _ExtentX        =   4048
  243.       _ExtentY        =   344
  244.       _Version        =   393216
  245.       LargeChange     =   16
  246.       Max             =   127
  247.       SelStart        =   127
  248.       TickFrequency   =   16
  249.       Value           =   127
  250.    End
  251.    Begin VB.Label Label3 
  252.       Caption         =   "&Velocity of New Notes"
  253.       Height          =   255
  254.       Left            =   3480
  255.       TabIndex        =   14
  256.       Top             =   1560
  257.       Width           =   1935
  258.    End
  259.    Begin VB.Label Label1 
  260.       Alignment       =   2  'Center
  261.       Caption         =   "Boids.dls - ""Vocals"" Instrument Regions"
  262.       BeginProperty Font 
  263.          Name            =   "Arial"
  264.          Size            =   8.25
  265.          Charset         =   0
  266.          Weight          =   400
  267.          Underline       =   0   'False
  268.          Italic          =   0   'False
  269.          Strikethrough   =   0   'False
  270.       EndProperty
  271.       Height          =   255
  272.       Left            =   428
  273.       TabIndex        =   7
  274.       Top             =   240
  275.       Width           =   4815
  276.    End
  277. Attribute VB_Name = "frmMain"
  278. Attribute VB_GlobalNameSpace = False
  279. Attribute VB_Creatable = False
  280. Attribute VB_PredeclaredId = True
  281. Attribute VB_Exposed = False
  282. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  283. '  Copyright (C) 1999-2001 Microsoft Corporation.  All Rights Reserved.
  284. '  File:       dlsfx.frm
  285. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  286. ' This application demonstrates the use of Downloadable Sounds for sound
  287. ' effects, and how to send MIDI notes.
  288. ' The DLS instruments are taken from Boids.dls. That collection actually
  289. ' contains only a single instrument, called Vocals. However, the instrument
  290. ' is based on different wave samples for different "regions" or ranges
  291. ' of notes. For example, the first speech sound is used when any note
  292. ' between C3 and B3 is sent. The speech sounds are played at the correct
  293. ' pitch only when the note is the lowest one in the region.
  294. ' One of the samples, called Heartbeat, is valid for the range B7-B8.
  295. ' Because this is not a vocal sample, we can reasonably vary the pitch
  296. ' by playing various notes within that range, as determined by the
  297. ' slider setting.
  298. ' Heartbeat is also the only sample in the DLS collection that is based
  299. ' on a looped wave. Hence it can be played continuously for up to the
  300. ' maximum duration of a note. The other samples will play only once
  301. ' regardless of the duration of the note sent.
  302. Option Explicit
  303. Const patch = 127 ' Assigned to "Vocals" instrument in Boids.dls
  304. Const channel = 1
  305. Const hbchannel = 32
  306. ' NoteDur is the duration of any of the non-repeating samples. It should
  307. ' be long enough to accommodate all the sound effects but not so long
  308. ' that notes continue using up resources (voices) after the sample has
  309. ' finished playing. Note that if you send the same note before the last
  310. ' one has finished playing, it might not play properly.
  311. Const NoteDurC3 = 4000  ' milliseconds
  312. Const NoteDurC4 = 7000  ' milliseconds
  313. Const NoteDurC5 = 5500  ' milliseconds
  314. Const NoteDurC6 = 5000  ' milliseconds
  315. Const NoteDurC7 = 2800  ' milliseconds
  316. Const NoteDurC9 = 5000  ' milliseconds
  317. Const NoteDurC10 = 3800  ' milliseconds
  318. Dim B7Freq As Byte
  319. Dim B7Playing As Boolean
  320. Dim gVelocity As Byte
  321. Dim mediapath As String
  322. Dim dx As New DirectX8
  323. Dim perf As DirectMusicPerformance8
  324. Dim coll As DirectMusicCollection8
  325. Dim seg As DirectMusicSegment8
  326. Private Sub SendNote(chan As Integer, pitch As Byte, dur As Long)
  327.   Dim noteMsg As DMUS_NOTE_PMSG
  328.   noteMsg.velocity = gVelocity
  329.   noteMsg.flags = DMUS_NOTEF_NOTEON
  330.   noteMsg.midiValue = pitch
  331.   noteMsg.mtDuration = dur
  332.   Call perf.SendNotePMSG(0, DMUS_PMSGF_REFTIME, chan, noteMsg)
  333.  End Sub
  334.  Private Sub B7NoteOff()
  335.  ' To turn off a note, we send a note-off message on the same
  336.  ' channel and at the same pitch.
  337.   Dim noteMsg As DMUS_NOTE_PMSG
  338.   noteMsg.flags = 0
  339.   noteMsg.midiValue = B7Freq
  340.   Call perf.SendNotePMSG(0, DMUS_PMSGF_REFTIME, hbchannel, noteMsg)
  341.  End Sub
  342. Private Sub cmdB7_Click()
  343.   ' For the hearbeat we'll send the note using a standard MIDI message.
  344.   ' That way we don't have to worry about the duration of the note;
  345.   ' it will play till we stop it.
  346.   Call perf.SendMIDIPMSG(0, DMUS_PMSGF_REFTIME, hbchannel, &H90, B7Freq, gVelocity)
  347.   B7Playing = True
  348.   cmdB7.Enabled = False
  349.   cmdOff.Enabled = True
  350. End Sub
  351. Private Sub cmdExit_Click()
  352.   Unload Me
  353. End Sub
  354. Private Sub cmdOff_Click()
  355.   B7NoteOff
  356.   B7Playing = False
  357.   cmdB7.Enabled = True
  358.   cmdOff.Enabled = False
  359. End Sub
  360. Private Sub cmdC3_Click()
  361.   SendNote channel, 36, NoteDurC3
  362. End Sub
  363. Private Sub cmdC4_Click()
  364.   SendNote channel, 48, NoteDurC4
  365. End Sub
  366. Private Sub cmdC5_Click()
  367.   SendNote channel, 60, NoteDurC5
  368. End Sub
  369. Private Sub cmdC6_Click()
  370.   SendNote channel, 72, NoteDurC6
  371. End Sub
  372. Private Sub cmdC7_Click()
  373.   SendNote channel, 84, NoteDurC7
  374. End Sub
  375. Private Sub cmdC9_Click()
  376.   SendNote channel, 108, NoteDurC9
  377. End Sub
  378. Private Sub cmdC10_Click()
  379.   SendNote channel, 120, NoteDurC10
  380. End Sub
  381. Private Sub Form_Load()
  382.     On Error GoTo FAILEDINIT
  383.     Dim dmA As DMUS_AUDIOPARAMS
  384.     Set perf = dx.DirectMusicPerformanceCreate
  385.     perf.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dmA, , DMUS_APATH_SHARED_STEREOPLUSREVERB, 64
  386.     On Error GoTo FAILEDLOAD
  387.     mediapath = FindMediaDir("sample.sgt")
  388.     If mediapath <> vbNullString Then ChDir mediapath
  389.     Dim loader As DirectMusicLoader8
  390.     Set loader = dx.DirectMusicLoaderCreate
  391.     Set coll = loader.LoadCollection(mediapath & "boids.dls")
  392.     ' Load any segment. We're not actually going to play it,
  393.     ' but we need a valid segment object so we can download the DLS.
  394.     Set seg = loader.LoadSegment(mediapath & "sample.sgt")
  395.     seg.ConnectToCollection coll
  396.     seg.Download perf.GetDefaultAudioPath
  397.     On Error GoTo 0
  398.     ' Assign the Vocals instrument to two channels
  399.     ' One will be used only for the heartbeat so we can pitch bend
  400.     Call perf.SendPatchPMSG(0, DMUS_PMSGF_REFTIME, channel, patch, 5, 0)
  401.     Call perf.SendPatchPMSG(0, DMUS_PMSGF_REFTIME, hbchannel, patch, 5, 0)
  402.     ' Initialize heartbeat note. B7 is MIDI note 95.
  403.     B7Freq = sliderB7.Value + 94
  404.     gVelocity = sliderVelocity.Value
  405.     Exit Sub
  406. FAILEDINIT:
  407.     MsgBox "Could not initialize DirectMusic." & vbCrLf & "This sample will exit.", vbOKOnly Or vbInformation, "Exiting..."
  408.     Unload Me
  409.     Exit Sub
  410. FAILEDLOAD:
  411.     MsgBox "Failed to load file."
  412.     Unload Me
  413.     Exit Sub
  414. End Sub
  415. Private Sub Form_Unload(Cancel As Integer)
  416.     If Not (seg Is Nothing) Then seg.Unload perf.GetDefaultAudioPath
  417.     Set seg = Nothing
  418.     If Not (perf Is Nothing) Then perf.CloseDown
  419.     Set perf = Nothing
  420.     End
  421. End Sub
  422. Private Sub sliderB7_Change()
  423.   B7NoteOff
  424.   B7Freq = 94 + sliderB7.Value
  425.   If B7Playing Then
  426.     Call perf.SendMIDIPMSG(0, DMUS_PMSGF_REFTIME, hbchannel, &H90, B7Freq, gVelocity)
  427.   End If
  428. End Sub
  429. Private Sub sliderPitch_Change()
  430.     Dim hi As Byte, lo As Byte
  431.     ' Split value into 7-bit bytes
  432.     hi = Fix(sliderPitch.Value / 128)
  433.     lo = CByte(sliderPitch.Value And 127)
  434.     ' Send pitch bend message
  435.     Call perf.SendMIDIPMSG(0, DMUS_PMSGF_REFTIME, hbchannel, &HE0, _
  436.         lo, hi)
  437. End Sub
  438. Private Sub sliderVelocity_Change()
  439.   gVelocity = sliderVelocity.Value
  440. End Sub
  441.